home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
wildcat
/
wc2pc091.zip
/
WC2PCB.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1996-04-13
|
5KB
|
187 lines
{$M 8192,0,0}
{$N-,E- no math support needed}
{$X- function calls may not be discarded}
{$I- disable I/O checking (trap errors by checking IOResult)}
PROGRAM Convert_Wildcat_file_lists_to_PCBoard_format;
USES DOS;
VAR
SavedExitProc: POINTER; { CustomExit proc inserted into normal exit. }
inFile, outFile : TEXT;
PROCEDURE NewLine; FORWARD;
PROCEDURE WriteStr (CONST s: STRING); FORWARD;
FUNCTION WordToHex (W: WORD): STRING; FORWARD;
PROCEDURE CustomExit; FAR; {---- Always exit through here ----}
CONST
NL = #13#10;
VAR
message: STRING [79];
BEGIN
ExitProc := SavedExitProc;
IF (ExitCode > 0) THEN BEGIN
NewLine;
WriteStr ('wc2PCB v0.91ß - Free DOS utility: Convert Wildcat file lists to PCBoard format.');
WriteStr ('April 13, 1996. Copyright (c) 1996 by David Daniel Anderson - Reign Ware.' + NL);
WriteStr ('Usage : wc2PCB <inFile> <outFile>'+ NL);
WriteStr ('Example : wc2PCB allfiles.lst allfiles.pcb');
END;
IF ErrorAddr <> NIL THEN
BEGIN
WriteStr ('An unanticipated error occurred, please contact DDA with the following data:');
WriteLn ('Address = ', WordToHex (Seg (ErrorAddr^)), ':', WordToHex (Ofs (ErrorAddr^)));
WriteLn ('Code = ', ExitCode);
ErrorAddr := NIL;
END
ELSE
IF (ExitCode IN [1..254]) THEN BEGIN
CASE ExitCode OF
7 : message := 'File handling error. Make sure you specified "inFile" and "outFile" properly.';
ELSE message := 'Unknown error.';
END;
WriteLn ('Error encountered (#', ExitCode, '):'); WriteStr (message);
END;
END;
PROCEDURE CheckIO; { Check IOResult, exit on error. }
BEGIN
IF IOResult <> 0 THEN Halt (7);
END;
PROCEDURE NewLine;
BEGIN
WriteLn;
END;
PROCEDURE WriteStr (CONST s: STRING);
BEGIN
WriteLn (s);
END;
CONST
HexDigits : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
FUNCTION ByteToHex (B: BYTE): STRING; {Convert a BYTE var to Hex string}
BEGIN
ByteToHex := Concat (HexDigits [B SHR 4], HexDigits [B AND $F]);
END;
FUNCTION WordToHex (W: WORD): STRING; {Convert a WORD var to Hex string}
BEGIN
WordToHex := ByteToHex (Hi (W)) + ByteToHex (Lo (W));
END;
PROCEDURE OpenFiles;
VAR
vErr: INTEGER;
BEGIN
IF ParamCount <> 2 THEN Halt (255);
Assign (inFile, ParamStr (1));
Reset (inFile); CheckIO;
Assign (outFile, ParamStr (2));
Rewrite (outFile); CheckIO;
Write ('Converting ' + ParamStr (1) + ' to ' + ParamStr (2));
END;
FUNCTION RTrim (InStr: STRING): STRING;
BEGIN
WHILE (Length (InStr) > 0) AND (InStr [Length (InStr)] IN [#0, #9, #32]) DO
Dec (InStr [0]);
RTrim := InStr;
END;
FUNCTION LTrim (InStr: STRING): STRING;
BEGIN
WHILE (Length (InStr) > 0) AND (InStr [1] IN [#0, #9, #32]) DO
Delete (InStr, 1, 1);
LTrim := InStr;
END;
FUNCTION Trim (InStr: STRING): STRING;
BEGIN
Trim := RTrim (LTrim (InStr));
END;
FUNCTION IsFirstLine (aLine: STRING): BOOLEAN;
VAR
First: BOOLEAN;
fSizeStr: STRING;
fSize, vErr: INTEGER;
BEGIN
First := FALSE;
IF (Length (aLine) >= 34) AND
(NOT (aLine [1] IN [' ', '*', '.', '?'])) AND
(Copy (aLine, 22, 3) = ' ') AND
(Copy (aLine, 33, 2) = ' |') AND
(aLine [27] = '/') AND (aLine [30] = '/')
THEN BEGIN
fSizeStr := Trim (Copy (aLine, 19, 3));
Val (fSizeStr, fSize, vErr);
IF (vErr = 0) AND (fSize >= 0) AND (fSize <= 999)
THEN First := TRUE;
END;
IsFirstLine := First;
END;
VAR
CurrLine: STRING;
Written,
EndOfDesc: BOOLEAN;
BEGIN
SavedExitProc := ExitProc;
ExitProc := @CustomExit; { Insert custom exit procedure. }
OpenFiles;
WHILE NOT EoF (inFile) DO
BEGIN
ReadLn (inFile, CurrLine);
CurrLine := RTrim (CurrLine);
Written := FALSE;
IF IsFirstLine (CurrLine) THEN
BEGIN
CurrLine := Copy (CurrLine, 1, 12) + #32#32 + { File name }
Copy (CurrLine, 13, 1) + { File size }
Copy (CurrLine, 15, 3) +
Copy (CurrLine, 19, 3) + #32#32 +
Copy (CurrLine, 25, 2) + #45 + { File date }
Copy (CurrLine, 28, 2) + #45 +
Copy (CurrLine, 31, 2) + #32#32 +
Copy (CurrLine, 36, Length (CurrLine) - 35); { File desc }
WriteLn (outFile, RTrim (CurrLine));
EndOfDesc := FALSE;
WHILE (NOT EndOfDesc) AND (NOT EoF (inFile)) DO
BEGIN
ReadLn (inFile, CurrLine);
CurrLine := RTrim (CurrLine);
Written := FALSE;
IF (Copy (CurrLine, 33, 2) <> ' |') THEN
EndOfDesc := TRUE
ELSE BEGIN
CurrLine := Copy (CurrLine, 36, Length (CurrLine) - 35);
IF (CurrLine <> '') THEN WriteLn (outFile, '': 33, CurrLine);
Written := TRUE;
END;
END;
END;
IF (NOT Written) AND (CurrLine <> '') THEN
BEGIN
IF Copy (CurrLine, 1, 6) = '**** [' THEN WriteLn (outFile);
WriteLn (outFile, CurrLine);
IF Copy (CurrLine, 1, 6) = '**** [' THEN WriteLn (outFile);
END;
END;
Close (InFile);
Close (OutFile);
WriteStr (', done!');
END.